(defpackage :happy-shell
  (:use :cl :mel :mel.pop3-server
	:happy-shell-settings)
  (:export #:repl
	   #:start-shell))

(in-package :happy-shell)

(defparameter *smiley-face* "                   ,ijfLLLLfji,.                  
              ;fWKK##############DL;              
           ;LDEKKDKKK###########EK##KG;           
         tWEEEGi.  ;DKK#######j.  :G###Kj         
       ,GDDDED:      WKK#####;      L####Ki       
      tDDDDDDi       :KKKK##L        K#####L      
     fWWWDDDD.        DKKKK#;        G######D.    
    fWWWWWWDW         LKKKKK:        j#######D    
   :GGWWWWWWW         GEEKKK,        f########;   
   jGGGGWWWWW,        DEEEKKt        D########D   
   LGGGGGWWWWf       tEEEEEED.      ;##########:  
  .LLGGGGGGWWWt     tDDDEEEEEG,    iE##########;  
   LLLLGGGGGGWWGjijGDDDDDEEEEEEGfLDKKK#########.  
   tLLLLLGGGGGGWWWWWWDDDDDDEEEEEEKKKKKK#######D   
   .LLLLLLGGGGGGGWWWWWWDDDDDEEEEEEEKKKKKK#####;   
    tfLLLLi :;LGGGWWWWWWWDDDDDEEEEEEWttEKKK##W    
     ifLLLfi.  ,tfGGWWWWWWDDDDDDEDL;  ,DKKKKW.    
      ;ffLLLLf;   .,tfGWWWWDDWLt,   ;LEEKKKf      
       :jffLLLLLLt;.            :tLDEEEEEW,       
         ,jfLLLLLLLGLfjjjjjjjfGWDDDDDEEWi         
           :ijLLLLLLGGGGGGWWWWWWDDDDWf,           
              :;tLLLLLGGGGGGWWWWWLt:              
                   .,;;iitii;,:                   


Welcome to your friendly computer. It is like a small child, and it
doesn't speak English very well. You have to say things its way, or it
won't understand you. Just type in whatever you want to say to it, and
press the key marked \"Enter\". If you want help, say \"help\".
")

(defun print-intro-message ()
  (princ *smiley-face* *query-io*))

(defparameter *continue-repl* t
  "Should the REPL continue looping?")

(defun repl ()
  (format *query-io* "~&~%Say: ")
  (finish-output *query-io*)
  (shell-eval (read-line *query-io* nil nil))
  (if *continue-repl*			; Loop?
      (repl)))

(defvar *current-directory* *home-directory*)

(defun goto-home-directory ()
  (setf *current-directory* *home-directory*))

(defun start-shell ()
  (print-intro-message)
  (setf *continue-repl* t)
  (repl))

(defparameter *command-table* '(("quit" . :quit)
				("bye" . :quit)
				("goodbye" . :quit)
				("help" . :help)
				("hello" . :hello)
				("what" . :file-list)
				("stuff" . :file-list)
				("files" . :file-list)
				("show" . :file-list)
				("send" . :send-email)
				("email" . :send-email)
				("mail" . :send-email)
				("read" . :read-email)
				("get" . :read-email))
  "Alist mapping one-word commands to symbols")

(defun command-matches (query command)
  (let ((regex-result (multiple-value-list (cl-ppcre:scan-to-strings
					    (format nil "^(please[ ]*)?(~A).*$"
						    command)
					    query))))
    (car regex-result)))

(defun get-command (string)
  (cdr (assoc string *command-table*
	      :test #'command-matches)))

(defun shell-quit ()
  (setf *continue-repl* nil))

(defparameter *help-message*
  "Hi! This computer acts like a small child, since that's the closest
you can get to its real personality. On your computer, you can write
things, or you can read and send e-mail. You can also organize the
things you've written, and print things.

You have some information saved. The information is saved in things
called files. A file can be something you wrote, like a letter.

To start writing things, you have to type \"write\", followed by a
space and the name of the file you want to write in. If the file
exists, the computer gets it and lets you change it. If it doesn't
exist, the computer will make it, and that's where it will put what
you write.

Once you've done this, press Enter. The computer will show you a
different screen. This is the typewriter screen. There is a black bar
at the top of the screen saying that it's GNU Nano. This is the name
of the typewriter screen. At the bottom are FIXME NANO STINKS

To quit, you have to hold down the key marked \"Ctrl\" (the control
key) and press the X key. Don't worry, you can't break anything.
")

(defun shell-help ()
  (princ *help-message* *query-io*))

(defun shell-hello ()
  (format *query-io* "Hi! I'm a computer. Say \"help\" if you want help.~%"))

(defun shell-file-list ()
  (format *query-io* "You have these files:~%")
  (loop for path in (directory (format nil "~A*" *current-directory*))
	do (format *query-io* "~A~%"
		   (pathname-name path))))

(defun shell-eval (query)
  "Evaluate a query"
  (case (get-command query)
    (:quit (shell-quit))
    (:help (shell-help))
    (:hello (shell-hello))
    (:file-list (shell-file-list))
    (:send-email (shell-send-email))
    (:read-email (fetch-emails-and-show))
    (t (or (match-write-command query)
	   (match-delete-command query)
	   (format *query-io*
		   "I don't know what you mean. Could you rephrase it?~%")))))

(defun match-write-command (query)
  "If `query' is a write command, match it and evaluate it"
  (multiple-value-bind (matched groups)
	  (cl-ppcre:scan-to-strings
	   "(write) (a |an |the |in |to )?(.*)$"
	   query)
	(declare (ignore matched))
	(when groups
	  (start-nano (elt groups 2)))))

(defun start-nano (filename)
  (sb-ext:run-program "/usr/bin/xterm"
		      `("-e"
			,(namestring (merge-pathnames "run-nano.sh"
						      *happyos-directory*))
			,*current-directory*
			,filename)))

(defun match-delete-command (query)
  "If `query' is a delete command, match it and evaluate it"
  (multiple-value-bind (matched groups)
	  (cl-ppcre:scan-to-strings
	   "(delete|remove|throw away|get rid of|trash) \"?([^\"]*)\"?$"
	   query)
	(declare (ignore matched))
	(when groups
	  (interactive-delete-file (elt groups 1))
	  t)))

(defun interactive-delete-file (filename)
  (handler-case (delete-file (merge-pathnames filename
					      *current-directory*))
		(file-error ()
		  (format *query-io* "I don't have a file called ~S~%"
			  filename))))

(defun shell-send-email (&aux address subject)
  "Interactively send an email message"
  (format *query-io* "What is the email address of the person you want
to send email to? Example: joe@gmail.com~%Say the address: ")
  (finish-output *query-io*)
  (setf address (read-line *query-io* nil nil))
  (format *query-io* "~&What is the subject of the email? Keep this short.
Say the subject: ")
  (finish-output *query-io*)
  (setf subject (read-line *query-io* nil nil))
  (format *query-io* "~%Okay, now I want you to write the email
message. When you're done, just save and quit.
Press Enter to continue...")
  (finish-output *query-io*)
  (read-line *query-io* nil nil)
  (let ((filename (format nil "email to ~A" address)))
    (start-nano filename)
    (send-email filename address subject))
  (format *query-io* "~&Email sent!~%"))

(defun send-email (filename address subject)
  "Send an email with a body taken from a file, to someone with a given
address, with a given subject."
  (let* ((smtp-server (make-smtp-relay-folder :host *smtp-host*
					      :username *smtp-username*
					      :password *smtp-password*))
	 (full-filename (merge-pathnames filename
					 *home-directory*))
	 (body (read-entire-file full-filename))
	 (mail-message (make-message :subject subject
				     :from *from-email-address*
				     :to address
				     :body body)))
    (copy-message mail-message smtp-server)
    (delete-file full-filename)))

(defun read-entire-file (filename)
  "Read an entire file into a string and return it"
  (with-output-to-string (s)
    (with-open-file (file filename)
      (loop for line = (read-line file nil nil)
	    while line
	    do (write-line line s)))))

(defun fetch-emails-and-show ()
  (let ((inbox (make-pop3-folder :host *pop3-host*
				 :username *pop3-username*
				 :password *pop3-password*)))
    (mapc #'show-email
	  (messages inbox))))

(defun show-email (message)
  (format *query-io* "You have an email from ~A.
Subject: ~A

Do you want to read it?
Say yes or no: "
	  (from message)
	  (subject message))
  (finish-output *query-io*)
  (let* ((answer-text (read-line *query-io* nil nil))
	 ;; We use the heuristic that "yes" is anything beginning with
	 ;; #\y or #\Y and "no" is anything else, such as "haberdasher".
	 ;; Needless to say, this could lead to some weird behavior.
	 (answer (or (eql (elt answer-text 0) #\y)
		     (eql (elt answer-text 0) #\Y)))
	 (filename (format nil "email from ~A" (from message)))
	 (full-filename (merge-pathnames filename
					 *home-directory*)))
    (when answer
      (with-open-file (file full-filename
		  	    :direction :output
			    :if-exists :supersede)
         (format file "From: ~A~%Subject: ~A~%~%"
		 (from message)
		 (subject message))
	 (with-open-stream (stream (message-body-stream message))
	    (loop for c = (read-char stream nil nil)
		  while c do (write-char c file))))
      (start-nano filename)
      (delete-file full-filename)
      (terpri *query-io*))))